home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Source Code / Peter Lewis / PNL Libraries / MyStrh.p < prev    next >
Encoding:
Text File  |  1994-09-03  |  4.0 KB  |  183 lines  |  [TEXT/PJMM]
  1. unit MyStrH;
  2.  
  3. interface
  4.  
  5. {$IFC undefined THINK_Pascal}
  6.     uses
  7.         Types;
  8. {$ENDC}
  9.  
  10.     type
  11.         lineIndex = integer;
  12.  
  13.     function NewStrH: handle;
  14.     procedure ReinitStrH (h: handle);
  15.     function CountStrs (id: integer): lineIndex;
  16.     function CountStrsH (h: handle): lineIndex;
  17.     function GetIndStr (id: integer; index: lineIndex): str255;
  18.     function GetIndStrH (h: handle; index: lineIndex): str255;
  19.     procedure SetIndStr (id, index: lineIndex; s: str255);
  20.     procedure SetIndStrH (h: handle; index: lineIndex; s: str255);
  21.     procedure DelIndStr (id: integer; index: lineIndex);
  22.     procedure DelIndStrH (h: handle; index: lineIndex);
  23.     procedure InsIndString (id: integer; index: lineIndex; s: str255);
  24.     procedure InsIndStrH (h: handle; index: integer; s: str255);
  25.  
  26. implementation
  27.  
  28. {$IFC undefined THINK_Pascal}
  29.     uses
  30.         Memory, Resources, ToolUtils;
  31. {$ENDC}
  32.  
  33.     type
  34.         indexPtr = ^lineIndex;
  35.         indexHandle = ^indexPtr;
  36.  
  37.     function NewStrH: handle;
  38.     begin
  39.         NewStrH := NewHandleClear(SizeOf(lineIndex));
  40.     end;
  41.  
  42.     procedure ReinitStrH (h: handle);
  43.     begin
  44.         SetHandleSize(h, SizeOf(lineIndex));
  45.         indexHandle(h)^^ := 0;
  46.     end;
  47.  
  48.     function CountStrsH (h: handle): integer;
  49.     begin
  50.         CountStrsH := indexHandle(h)^^;
  51.     end;
  52.  
  53.     function CountStrs (id: integer): lineIndex;
  54.         var
  55.             h: handle;
  56.     begin
  57.         h := GetResource('STR#', id);
  58.         CountStrs := indexHandle(h)^^;
  59.     end;
  60.  
  61.     function GetIndStr (id: integer; index: lineIndex): str255;
  62.         var
  63.             s: str255;
  64.     begin
  65.         GetIndString(s, id, index);
  66.         GetIndStr := s;
  67.     end;
  68.  
  69.     function GetIndStrH (h: handle; index: lineIndex): str255;
  70.         var
  71.             count, i: lineIndex;
  72.             s: str255;
  73.             ps: longInt;
  74.     begin
  75.         count := indexHandle(h)^^;
  76.         if (1 <= index) and (index <= count) then begin
  77.             ps := SizeOf(lineIndex);
  78.             for i := 1 to index - 1 do
  79.                 ps := ps + BAND(ptr(ord(h^) + ps)^, $FF) + 1;
  80.             BlockMove(ptr(ord(h^) + ps), @s, BAND(ptr(ord(h^) + ps)^, $FF) + 1);
  81.         end
  82.         else
  83.             s := '';
  84.         GetIndStrH := s;
  85.     end;
  86.  
  87.     procedure SetIndStrH (h: handle; index: lineIndex; s: str255);
  88.         var
  89.             count, i: lineIndex;
  90.             sz: longInt;
  91.             p: longInt;
  92.             err: longInt;
  93.             ps: longInt;
  94.     begin
  95.         count := indexHandle(h)^^;
  96.         sz := GetHandleSize(h);
  97.         if count < index then begin
  98.             SetHandleSize(h, sz + index - count);
  99.             for p := ord(h^) + sz to ord(h^) + sz + index - count - 1 do
  100.                 ptr(p)^ := 0;
  101.             indexHandle(h)^^ := index;
  102.             count := index;
  103.         end;
  104.         ps := SizeOf(lineIndex);
  105.         for i := 1 to index - 1 do
  106.             ps := ps + BAND(ptr(ord(h^) + ps)^, $FF) + 1;
  107.         err := Munger(h, ps, nil, BAND(ptr(ord(h^) + ps)^, $FF) + 1, @s, length(s) + 1);
  108.     end;
  109.  
  110.     procedure SetIndStr (id, index: lineIndex; s: str255);
  111.         var
  112.             h: handle;
  113.     begin
  114.         h := GetResource('STR#', id);
  115.         HNoPurge(h);
  116.         SetIndStrH(h, index, s);
  117.         HPurge(h);
  118.         ChangedResource(h);
  119.         WriteResource(h);
  120.     end;
  121.  
  122.     procedure DelIndStrH (h: handle; index: integer);
  123.         var
  124.             count, i: lineIndex;
  125.             sz: longInt;
  126.             err: longInt;
  127.             ps: longInt;
  128.     begin
  129.         count := indexHandle(h)^^;
  130.         sz := GetHandleSize(h);
  131.         if count >= index then begin
  132.             ps := SizeOf(lineIndex);
  133.             for i := 1 to index - 1 do
  134.                 ps := ps + BAND(ptr(ord(h^) + ps)^, $FF) + 1;
  135.             err := Munger(h, ps, nil, BAND(ptr(ord(h^) + ps)^, $FF) + 1, @err, 0); { @err is a safe, non nil addr }
  136.             indexHandle(h)^^ := count - 1;
  137.         end;
  138.     end;
  139.  
  140.     procedure DelIndStr (id: integer; index: lineIndex);
  141.         var
  142.             h: handle;
  143.     begin
  144.         h := GetResource('STR#', id);
  145.         HNoPurge(h);
  146.         DelIndStrH(h, index);
  147.         HPurge(h);
  148.         ChangedResource(h);
  149.         WriteResource(h);
  150.     end;
  151.  
  152.     procedure InsIndStrH (h: handle; index: integer; s: str255);
  153.         var
  154.             count, i: lineIndex;
  155.             err: longInt;
  156.             ps: longInt;
  157.             t: string[2];
  158.     begin
  159.         count := indexHandle(h)^^;
  160.         if count >= index then begin
  161.             ps := SizeOf(lineIndex);
  162.             for i := 1 to index - 1 do
  163.                 ps := ps + BAND(ptr(ord(h^) + ps)^, $FF) + 1;
  164.             t := '';
  165.             err := Munger(h, ps, nil, 0, @t, length(t) + 1);
  166.             indexHandle(h)^^ := count + 1;
  167.         end;
  168.         SetIndStrH(h, index, s)
  169.     end;
  170.  
  171.     procedure InsIndString (id: integer; index: lineIndex; s: str255);
  172.         var
  173.             h: handle;
  174.     begin
  175.         h := GetResource('STR#', id);
  176.         HNoPurge(h);
  177.         InsIndStrH(h, index, s);
  178.         HPurge(h);
  179.         ChangedResource(h);
  180.         WriteResource(h);
  181.     end;
  182.  
  183. end.